home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Windows 1993 Fall / TestDrive Windows 1993 Fall.iso / dbase / samples / invoices.prg < prev    next >
Encoding:
Text File  |  1993-03-09  |  12.0 KB  |  404 lines

  1. ******************************************************************************
  2. * PROGRAM NAME: INVOICES.PRG
  3. *               SAMPLE CUSTOM REPORT - INVOICES
  4. *               GENERATES INVOICES & UPDATES ACCT_REC.DBF
  5. *               SAMPLE BUSINESS APPLICATION
  6. * LAST CHANGED: 09/25/89 09:26AM
  7. * WRITTEN BY:   Borland International Inc.
  8. ******************************************************************************
  9. *              Logic and some variable names modeled after reports generator
  10. ******************************************************************************
  11. *
  12. SET PROCEDURE TO Library
  13. DO WHILE .NOT. PRINTSTATUS()
  14.    DO Err_Box WITH "Printer not ready, press Escape to cancel"
  15.    IF LASTKEY() = 27
  16.       RETURN
  17.    ENDIF
  18. ENDDO
  19.  
  20. SET COLOR TO &c_normal.
  21. CLEAR
  22. inv_month = 0
  23. ll_ans = NodShake(" ;                        INVOICE PRINTING ; ;" + ;
  24.                   " ************************************************************** ;" + ;
  25.                   "  This will process and alter current data in: Acct_rec,Orders ; ;" + ;
  26.                   "            Are you sure you want to print invoices?", ;
  27.                     6, 6, 7, 65, .T. )
  28. answer = IIF( ll_ans, "Y", "N" )
  29.  
  30. IF answer = "N"
  31.    RETURN TO Business
  32. ELSE
  33.    ?? CHR(7)
  34.    inv_month = MONTH(DATE())-1
  35.    @ 10, 8 CLEAR TO 14,72
  36.    @ 12,12 SAY "What month do want to process orders for (01-12)?" ;
  37.       GET inv_month PICTURE "99" RANGE 1,12
  38.    READ
  39. ENDIF
  40.  
  41. * Open database files and choose active indexes
  42. SELECT 1
  43. USE Orders   ORDER Order
  44. USE Cust     ORDER Cust_id IN 2
  45. USE Acct_rec ORDER Cust_id IN 3
  46. USE Goods    ORDER part_id IN 4
  47.  
  48. * Relate database files and activate the relation
  49. SET RELATION TO cust_id INTO Cust, cust_id INTO Acct_rec, part_id INTO Goods
  50. GO TOP
  51.  
  52. * Error message window
  53. DEFINE WINDOW err_wndo FROM 16,3 TO 23,60 COLOR &c_pop.
  54.  
  55. * If user presses Esc during printing, exit
  56. ON ESCAPE DO Stop_rpt
  57.  
  58. * Process errors
  59. ON ERROR DO Err_msg
  60.  
  61. * Set up environment
  62. SET SPACE OFF
  63. _plineno  =  0
  64. _peject   = "NONE"
  65. _pageno   = 1
  66.  
  67. * Initialize variables
  68. continu_on  = .T.               && Continue printing flag - set by Esc to .F.
  69. complete = .F.
  70. on_pg_line = 0                  && Line at which ON PAGE works
  71. STORE 0  TO amt_of_bil, amt_of_cur, inv_amount, oldbalance
  72. STORE 0  TO inv_count, ord_count, grand_tot, tot_price
  73. STORE "" TO invoice_no, mcust_id, today, this_year, this_month
  74. today      = DTOC(DATE())
  75. this_year  = RIGHT(today,2)
  76. this_month = LEFT(today,2)
  77.  
  78. * Calculate line no. to break page on
  79. on_pg_line = INT(_plength - 6)  && Height minus footer and margin
  80.  
  81. * Set up line number where page break procedure executes
  82. ON PAGE AT LINE on_pg_line DO Page_brk
  83.  
  84. SET CONSOLE off
  85. SET PRINTER on
  86. *================================ Begin Print Job ============================
  87. PRINTJOB
  88.    * ======= File loop - process records in index order to end of file =======
  89.    *                     or until user presses Esc (continu_on = .F.)
  90.    * Process all uninvoiced records for a particular customer
  91.    SCAN FOR .NOT. invoiced .AND. inv_month = MONTH(date_trans) ;
  92.         WHILE continu_on
  93.       mcust_id = cust_id
  94.       DO Pg_head      && Print standard page heading
  95.       DO Inv_head     && Print invoice heading
  96.       complete = .F.  && Flag customer's invoices not completely processed
  97.       * Print orders for this customer
  98.       SCAN FOR .NOT. invoiced .AND. inv_month = MONTH(date_trans) ;
  99.            WHILE cust_id = mcust_id .AND. continu_on
  100.          DO Detail
  101.       ENDSCAN
  102.       complete = .T.  && Flag customer's invoices are completely processed
  103.       SKIP -1         && Return to last record for customer
  104.       DO Inv_calc     && Print invoice total for last customer
  105.       EJECT PAGE      && Print invoice footer - Inv_foot called by ON PAGE
  106.       DO Updat_ar     && Update Acct_rec database file with processed data
  107.       DO Reinit       && Re-initialize summary variables
  108.    ENDSCAN
  109.    IF continu_on
  110.       * End of file - User did not press Esc to stop printing
  111.       message = "Invoices were completely processed and printed for month " ;
  112.                 + STR(inv_month,2)
  113.    ELSE
  114.       * Not EOF - User pressed Esc to stop printing
  115.       message = "Invoices were NOT COMPLETED - stopped by user at " + TIME()
  116.    ENDIF
  117.    DO Rpt_end WITH message
  118.    ON PAGE
  119. ENDPRINTJOB
  120. *============================= End Print Job =================================
  121. EJECT PAGE
  122. ON PAGE
  123. SET CONSOLE on
  124. SET PRINTER off
  125. CLEAR
  126. ll_ans = NodShake(" ;                        ARCHIVE ORDERS   ; ;" + ;
  127.                   " ************************************************************** ;" + ;
  128.                   " (Copy processed orders to archive file and delete from Orders); ;" + ;
  129.                   "        Do you want to archive the processed orders?", ;
  130.                     6, 6, 7, 65, .F. )
  131. answer = IIF( ll_ans, "Y", "N" )
  132. IF answer = "Y"
  133.    ?? CHR(7)
  134.    @ 10,12 SAY "COPYING processed orders...please wait                 "
  135.    @ 12,10 SAY SPACE(61)
  136.    @ 13,10 SAY SPACE(63)
  137.  
  138.    CLOSE DATABASES
  139.    * Create an archive database file for processed orders.
  140.    * Records will be copied to it, then erased from Orders.
  141.    IF .NOT. FILE("Archiv_o.dbf")
  142.       USE Orders
  143.       COPY STRUCTURE TO Archiv_o
  144.    ENDIF
  145.    USE Archiv_o
  146.  
  147.    APPEND FROM Orders FOR invoiced
  148.  
  149.    *-- Remove the archived records from Orders
  150.    USE Orders
  151.    SET TALK on
  152.    DELETE ALL FOR invoiced
  153.    @ 10,10 SAY "ERASING processed orders...please wait               "
  154.    PACK
  155.    SET TALK off
  156. ELSE
  157.    ?? CHR(7)
  158.    DO Err_Box WITH "Processed orders will not be erased"
  159. ENDIF
  160. ON ESCAPE
  161. ON ERROR
  162. CLOSE ALL
  163. SET PROCEDURE TO
  164. RETURN TO Business
  165. ********************* END OF MAIN REPORT PROCEDURE ***************************
  166.  
  167. * UTILITY PROCEDURES
  168.  
  169. PROCEDURE Detail
  170.    * Print report detail
  171.    ?? date_trans       AT 0,
  172.    ?? part_id          AT 10,
  173.    ?? Goods->part_name AT 21,
  174.    ?? part_qty         AT 53 PICTURE "999",
  175.    ?? Goods->price     AT 58 PICTURE "99,999.99",
  176.    * Extend price
  177.    tot_price  = ROUND(part_qty * Goods->price,2)
  178.    ?? tot_price        AT 70 PICTURE "99,999.99"
  179.    ?
  180.    * Accumulate total amount of current invoice
  181.    amt_of_cur = amt_of_cur + tot_price
  182.    * Accumulate number of orders processed
  183.    ord_count  = ord_count + 1
  184.    * Update the posted flag "invoiced" to .T. in Orders dbf for this order
  185.    REPLACE invoiced WITH .T.
  186. RETURN
  187.  
  188. PROCEDURE Err_msg
  189.    * Error messages
  190.    SET PRINTER off
  191.    SET CONSOLE on
  192.    ACTIVATE WINDOW err_wndo
  193.       CLEAR
  194.       ? "--------------------- ERROR WARNING --------------------"
  195.       IF .NOT. PRINTSTATUS()
  196.          * Printer caused error
  197.          msg = "Printer error - fix paper or select ONLINE button"
  198.       ELSE
  199.          * Unknown cause of error - show system message
  200.          msg = MESSAGE()
  201.       ENDIF
  202.       ? " Error Number ", LTRIM(STR(ERROR(),4))
  203.       ? " " + msg
  204.       WAIT " Press spacebar to continue..."
  205.    DEACTIVATE WINDOW err_wndo
  206.    SET CONSOLE off
  207.    SET PRINTER on
  208. RETURN
  209.  
  210. PROCEDURE Inv_calc
  211.    * Print calculated summary data on details at cust_id break
  212.    amt_of_bil = amt_of_cur + oldbalance
  213.    ?? "----------" AT 69
  214.    ?
  215.    ?? "CURRENT ORDERS" AT 0,
  216.    ?? "$" AT 66,
  217.    ?? amt_of_cur PICTURE "999,999.99" AT 69
  218.    ?
  219.    IF oldbalance <> 0
  220.       ?? "----------" AT 69
  221.       ? "+ OLD BALANCE"
  222.       ?? oldbalance PICTURE "999,999.99" AT 69,
  223.       ?
  224.    ENDIF
  225.    ?? "==========" AT 69
  226.    ?
  227.    ?? "TOTAL AMOUNT DUE" STYLE "B" AT 0,
  228.    ?? "$" STYLE "B" AT 66,
  229.    ?? amt_of_bil PICTURE "999,999.99" STYLE "B" AT 69
  230.    ?
  231.    ?? "==========" AT 69
  232.    * Accumulate total billings for end of report
  233.    grand_tot = grand_tot + amt_of_bil
  234.    ?
  235.    ?
  236. RETURN
  237.  
  238. PROCEDURE Inv_foot
  239.    * Print invoice page footer
  240.    ?
  241.    ? "TERMS: " AT 27,Cust->terms
  242.    ?
  243.    ? Acct_rec->notes  AT 18
  244.    * Start new page
  245.    EJECT PAGE
  246. RETURN
  247.  
  248. PROCEDURE Inv_head
  249.    * Encode new unique invoice number
  250.    invoice_no = cust_id + this_year + this_month
  251.    * Increment invoice count
  252.    inv_count  = inv_count + 1
  253.    ?
  254.    ?? "INVOICE NO.: " STYLE "B" AT 0,
  255.    ?? invoice_no STYLE "B" FUNCTION "T" PICTURE "XXXXXXXXXX" ,
  256.    ?? DATE() AT 69
  257.    ?
  258.    ?
  259.    ?? "CUSTOMER NO.: " AT 0,
  260.    ?? cust_id FUNCTION "T" PICTURE "XXXXXX"
  261.    ?
  262.    ?
  263.    ?? Cust->customer AT 0
  264.    ?
  265.    ?? Cust->address1 AT 0, Cust->address2 AT LEN(TRIM(Cust->address1))+2
  266.    ?
  267.    ?? Cust->city PICTURE "@T XXXXXXXXXXXXXXXXXXXX" AT 0,
  268.    ?? ", ",
  269.    ?? Cust->state," ",
  270.    ?? Cust->zip
  271.    ?
  272.    ?? "ATTENTION: " AT 0 ,
  273.    ?? Cust->contact PICTURE "@T XXXXXXXXXXXXXXXXXXXX","  ",
  274.    ?? Cust->phone_cont
  275.    ?
  276.    ?  REPLICATE(CHR(205),80)        && Draw double line 80 characters wide
  277.    ?
  278.    ?
  279.    ?? "PREVIOUS ACTIVITY:" STYLE "BU" AT 0
  280.    ?
  281.    ?? "INVOICE NO.:" AT 4, Acct_rec->invoic_old AT 15
  282.    ?? "SENT:" AT 31, Acct_rec->dat_lstbil AT 37
  283.    ?
  284.    ?? "AMOUNT  $ " AT 4, Acct_rec->amt_lstbil PICTURE "999,999.99" AT 15
  285.    ?
  286.    ?? "PAID    $ " AT 4, Acct_rec->amt_lst_pd PICTURE "999,999.99" AT 15
  287.    ?
  288.    ?? "----------" AT 15
  289.    ?
  290.    ?? "BALANCE $ " AT 4
  291.    oldbalance = Acct_rec->oldbalance
  292.    ?? oldbalance PICTURE "999,999.99" AT 15
  293.    ?
  294.    ?
  295.    ?? "CURRENT ACTIVITY:" STYLE "BU" AT 0
  296.    ?  REPLICATE(CHR(196),80)        && Draw single line 80 characters wide
  297.    ?  "Ordered"    AT 0
  298.    ?? "Part no."   AT 10
  299.    ?? "Part name"  AT 21
  300.    ?? "Qty"        AT 53
  301.    ?? "Price"      AT 59
  302.    ?? "Total"      AT 74
  303.    ?  REPLICATE(CHR(196),80)        && Draw single line 80 characters wide
  304.    ?
  305. RETURN
  306.  
  307. PROCEDURE Page_brk
  308.    * Page break logic - occurs when report detail line = on_pg_line
  309.    DO Inv_foot
  310.    * Print heading if customer's invoices were not completed on prior page
  311.    IF .NOT. EOF() .AND. .NOT. complete
  312.       DO Pg_head
  313.    ENDIF
  314. RETURN
  315.  
  316. PROCEDURE Pg_head
  317.    * Print information at top of each invoice page
  318.    ?
  319.    ?  "Page " ,
  320.    ?? _pageno PICTURE "999"
  321.    ?
  322.    ?
  323.    ?  "A-T  FURNITURE INDUSTRIES" STYLE "B"   AT 27
  324.    ?
  325.    DEFINE BOX FROM 34 TO 45 HEIGHT 3 SINGLE
  326.    ?
  327.    ?? "INVOICE" STYLE "B" AT 36
  328.    ?
  329.    ?
  330.    ?  REPLICATE(CHR(205),80)        && Draw double line 80 characters wide
  331.    ?
  332. RETURN
  333.  
  334. PROCEDURE Reinit
  335.    * Re-initialize summary/calculation variables at customer breaks
  336.    STORE 0 TO amt_of_cur, inv_amount
  337.    _pageno = 1
  338. RETURN
  339.  
  340. PROCEDURE Rpt_end
  341.    PARAMETERS message
  342.    * Print end-of-report summary data
  343.    ?
  344.    ?
  345.    ?  "A-T  FURNITURE INDUSTRIES" STYLE "BU"   AT 27
  346.    ?
  347.    ?
  348.    ?  "INVOICE SUMMARY PAGE" STYLE "B" AT 30
  349.    ?
  350.    inv_date = CTOD(STR(inv_month,2)+RIGHT(DTOC(DATE()),6))
  351.    ?  "FOR MONTH of " AT 31, CMONTH(inv_date)
  352.    ?
  353.    ?
  354.    ?
  355.    ?  REPLICATE(CHR(205),80)        && Draw double line 80 characters wide
  356.    ?  DATE() AT 0 ,
  357.    ?? TIME() AT 69
  358.    ?  REPLICATE(CHR(205),80)        && Draw double line 80 characters wide
  359.    ?
  360.    ?
  361.    ?
  362.    ?
  363.    ?? "===========" AT 67,
  364.    ?
  365.    ?? "GRAND TOTAL for " AT 0,
  366.    ?? inv_count PICTURE "999",
  367.    ?? " invoices " AT 21,
  368.    ?? "and ", ord_count PICTURE "9,999",
  369.    ?? " orders:",
  370.    ?? "$" AT 66,
  371.    ?? grand_tot PICTURE "999,999.99" ,
  372.    ?
  373.    ?? "===========" AT 67
  374.    ?
  375.    ?
  376.    ?
  377.    ?  message AT 6
  378.    ?
  379. RETURN
  380.  
  381. PROCEDURE Stop_rpt
  382.    continu_on = .F.   && Set stop printing flag to .F. when user presses Esc
  383. RETURN
  384.  
  385. PROCEDURE Updat_ar
  386.    * Update the related Acct_rec database record for this customer with data
  387.    * processed/calculated during invoicing and prior data
  388.    SELECT Acct_rec
  389.    IF Orders->cust_id <> cust_id
  390.       * If customer has never been invoiced, create an AR record for customer
  391.       APPEND BLANK
  392.       REPLACE cust_id WITH Orders->cust_id
  393.    ENDIF
  394.    REPLACE invoic_old WITH invoice_no, dat_lstbil WITH dat_of_bil, ;
  395.            amt_lst_pd WITH amt_cur_pd, amt_lstbil WITH amt_of_cur, ;
  396.            oldbalance WITH amt_lstbil - amt_lst_pd, comments WITH "", ;
  397.            notes WITH "", invoice_no WITH m->invoice_no, ;
  398.            dat_of_bil WITH DATE(), amt_of_cur WITH m->amt_of_cur, ;
  399.            amt_of_bil WITH m->amt_of_bil
  400.    SELECT Orders
  401. RETURN
  402.  
  403. ****************************************** END OF INVOICES.PRG ***************
  404.